perm filename COORDS.F4[DRW,LCS] blob
sn#493201 filedate 1980-01-11 generic text, type T, neo UTF8
C THIS PROGRAM EXTRACTS THE X-Y COORDINATES FROM 'DRAW' LIBRARY FILES.
C IT MAY BE THAT THE NAME EXTENSIONS MUST BE CHANGED FOR THIS TO WORK.
COMMON J(512),K(3),JJ(21),M
TYPE 1000
1000 FORMAT(' FILE NAME (NO EXT.) -- '$)
1001 FORMAT(A5)
ACCEPT 1001,NAME
TYPE 1
1 FORMAT(' TO DSK? TYPE Y OR N'/)
ACCEPT 11,L
M=5
IF(L.NE.'Y')GO TO 3
M=1
TYPE 2
2 FORMAT(' WRITING FILE FOR01.DAT'/)
3 CALL GETFILE(NAME)
CALL FASTIN(JJ,21 )
11 FORMAT(A1)
10 FORMAT(10I8,/I4,/2X,10(3XA5))
WRITE(M,10),JJ
N=JJ(11)
C WD CNT
CALL FASTIN(J,N)
CALL RDRAW(1,J(1),J)
END
SUBROUTINE RDRAW(I,JA,IJ)
COMMON J(512),K(3),JJ(21),M
DIMENSION IJ(1)
I=1
WRITE(M,4),JJ(1)
DO 3 KK=1,10
KA=0
JA=JJ(KK)
DO 2 L=I,JA
CALL UNPACK(L,IA,IB,J)
KA=KA+1
IF(L.NE.JA)GO TO 2
KA=0
WRITE(M,4),JJ(KK+11)
2 WRITE(M,10),KA,IA,IB,J(L)
3 I=JA+1
4 FORMAT(/1XA5)
10 FORMAT(4I)
END
SUBROUTINE UNPACK(K,M,N,I)
COMMON/LL/L
C L IS FOR VIS. OR INVIS. LINES.
DIMENSION I(1)
N=I(K)
L=0
IF(N.LT.100000000)GO TO 2
L=(N/100000000)*100000000
N=N-L
2 M=N/10000
N=N-M*10000
IF(M.GT.1000)M=1000-M
IF(N.GT.1000)N=1000-N
END